{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  joost.visser@di.uminho.pt, alcino@di.uminho.pt
-- Stability   :  experimental
-- Portability :  portable
--
-- Example of format evolution and data mapping, using a datatype
-- for music albums.
--
-----------------------------------------------------------------------------

module Data.Transform.TwoLevelAlbumExample where

import Data.Transform.Coupled
import Data.List as List

-----------------------------------------------------------------------------

{-

The example is inspired on the following DTD for music album formats:

<!ELEMENT album (title, artist, recording?, catalogno*, player+, track*, notes)> 
<!ELEMENT title (#PCDATA)> 
<!ELEMENT artist (#PCDATA)> 
<!ELEMENT recording EMPTY> 
<!ATTLIST recording 
      date CDATA #IMPLIED 
      place CDATA #IMPLIED> 
<!ELEMENT catalogno EMPTY> 
<!ATTLIST catalogno
      label   CDATA #REQUIRED 
      number  CDATA #REQUIRED 
      format  (CD | LP | MiniDisc) #IMPLIED 
      releasedate     CDATA #IMPLIED 
      country CDATA #IMPLIED> 
<!ELEMENT player EMPTY> 
<!ATTLIST player 
      name CDATA #REQUIRED 
      instrument CDATA #REQUIRED> 
<!ELEMENT track EMPTY> 
<!ATTLIST track 
      title CDATA #REQUIRED 
      credit CDATA #IMPLIED 
      timing CDATA #IMPLIED> 
<!ELEMENT notes (#PCDATA | albumref | trackref)*> 
<!ATTLIST notes 
      author CDATA #IMPLIED> 
<!ELEMENT albumref (#PCDATA)> 
<!ATTLIST albumref 
      link CDATA #REQUIRED> 
<!ELEMENT trackref (#PCDATA)> 
<!ATTLIST trackref 
      link CDATA #IMPLIED> 

In the paper, we present a smaller format, specified with XML Schema:

<element name="Album" type="AlbumType"/> 
<complexType name="AlbumType"/> 
  <attribute name="ASIN" type="string"/> 
  <attribute name="Title" type="string"/> 
  <attribute name="Artist" type="string"/> 
  <attribute name="Format"><simpleType base="string"> 
    <enumeration value="LP"/><enumeration value="CD"/> 
  </simpleType></attribute> 
</complexType> 

-}

-----------------------------------------------------------------------------
-- * Set up the format and some data

-- | The album format, encoded in Haskell.
albumFormat :: Type (String, (String, (String, Either () ())))
albumFormat
 = Tag "Album" (
       Prod (Tag "ASIN" String) (
       Prod (Tag "Title" String) (
       Prod (Tag "Artist" String) 
            (Tag "Format" (Either (Tag "LP" One) (Tag "CD" One))))))
            
-- | Example album: Abbey Road by The Beatles.
lp ::(String, (String, (String, Either () ())))
lp = ("B000002UB2",("Abbey Road",("The Beatles",Left ())))
  where _ = constrain albumFormat lp

-- | Example album: Debut by Bjork.
cd :: (String, (String, (String, Either () ())))
cd = ("B000002HCO",("Debut",("Bjork", Right ())))
  where _ = constrain albumFormat cd

-----------------------------------------------------------------------------
-- * Format evolution

-- | Add an alternative: format can now also be DVD.
addDvd = once (inside "Format" (addalt (Tag "DVD" One)))

-- | Adding a field: track list retrieved from some data source.
addTracks = once (inside "Album" (addinfo (List (Tag "Title" String)) aux))
   where aux :: Query [String]
         aux (Prod (Tag "ASIN" String) _) = FUN "query" (\(asin,_) -> graceNote asin)
         aux _ = FUN "query" (\ _ -> [])



-- | Looking up track listings from a database such as GraceNote.
graceNote :: String -> [String]
graceNote asin = maybe [] id $ List.lookup asin db
  where
    db = [ ("B000002UB2",
            ["Come Together","Something","Maxwell's Silver Hammer",
             "Oh! Darling","Octopus's Garden","I Want You (She's So Heavy)",
             "Here Comes the Sun","Because","You Never Give Me Your Money",
             "Sun King","Mean Mr. Mustard","Polythene Pam",
             "She Came in Through the Bathroom Window","Golden Slumbers",
             "Carry That Weight","End","Her Majesty"])
         , ("B000002HCO",
            ["Human Behaviour","Crying","Venus As A Boy",
             "There's More To Life Than This - Recorded Live At The Milk Bar Toilets",
             "Like Someone In Love","Big Time Sensuality","One Day","Aeroplane",
             "Come To Me","Violently Happy","The Anchor Song"
            ])
         ]
 
-----------------------------------------------------------------------------
-- * Test run

-- | Automated test of both scenarios.
test = do
  putStrLn ">>> START TEST <<<"

  -- Running the type-level transformation to obtain target format as String.
  let (Just vw) = (addTracks >>> addDvd) albumFormat
  let targetFormatAsString = showType vw
  putStrLn $ snip $ "Target format: "++targetFormatAsString
  if targetFormatAsString==show intendedTargetFormat
    then putStrLn "Type-level evolution OK"
    else fail "Type-level evolution FAILED"
  
  --  Then running the forward value-level transformation.
  let targetFormat = Tag "Album" (Prod (Prod (Tag "ASIN" String) (Prod (Tag "Title" String) (Prod (Tag "Artist" String) (Tag "Format" (Either (Either (Tag "LP" One) (Tag "CD" One)) (Tag "DVD" One)))))) (List (Tag "Title" String)))
  let (Just targetAlbum) = forth vw targetFormat lp
  putStrLn $ snip $ gshow targetFormat targetAlbum
  if targetAlbum==targetLP
    then putStrLn "Forward migration OK"
    else fail "Forward migration FAILED"

  -- And the backward value-level transformation.
  let (Just originalAlbum) = back vw targetFormat targetAlbum
  putStrLn $ snip $ gshow albumFormat originalAlbum
  if lp==originalAlbum
    then putStrLn $ "Backward migration OK"
    else fail "Backward migration FAILED"
    
  -- Running the type-level data mapping on both hierarchical formats.
  let toRDB = once enum2int >>> removetags >>> flatten
  let (Just vw0) = toRDB (List albumFormat)
  putStrLn $ snip $ showType vw0
  let (Just vw1) = toRDB (List targetFormat)
  putStrLn $ snip $ showType vw1
  if (showType vw0)==(show intendedTargetDBS0) && (showType vw1)==(show intendedTargetDBS1)
    then putStrLn "Type-level data mapping OK"
    else fail "Type-level data mapping FAILED"

  -- Running the forward value-level data mapping on two albums.
  let dbs0 = Map Int (Prod String (Prod String (Prod String Int)))
  let (Just db) = forth vw0 dbs0 [lp,cd]
  putStrLn $ snip $ show db
  putStrLn "Forward value-level data mapping OK (it seems)"
  
  -- Migrate from and old database to an update one.\begin{code}
  let (Just lvw) = (addTracks >>> addDvd) (List albumFormat)
  let dbs1 = Prod (Map Int (Prod String (Prod String (Prod String Int)))) (Map (Prod Int Int) String)
  let (Just x) = back vw0 dbs0 db 
  let (Just y) = forth lvw (List targetFormat) x
  let (Just z) = forth vw1 dbs1 y
  putStrLn $ snip $ show z
  putStrLn "Value-level data base migration OK (it seems)"

  putStrLn ">>> TEST SUCCESSFUL <<<"

snip :: String -> String
snip x = "  "++(take 45 x)++" ... "++(takeLast 25 x)
  where
    takeLast n = reverse . (take n) . reverse
     
targetLP = (("B000002UB2",("Abbey Road",("The Beatles",Left (Left ())))),["Come Together","Something","Maxwell's Silver Hammer","Oh! Darling","Octopus's Garden","I Want You (She's So Heavy)","Here Comes the Sun","Because","You Never Give Me Your Money","Sun King","Mean Mr. Mustard","Polythene Pam","She Came in Through the Bathroom Window","Golden Slumbers","Carry That Weight","End","Her Majesty"])
             
intendedTargetFormat = Tag "Album" (Prod (Prod (Tag "ASIN" String) (Prod (Tag "Title" String) (Prod (Tag "Artist" String) (Tag "Format" (Either (Either (Tag "LP" One) (Tag "CD" One)) (Tag "DVD" One)))))) (List (Tag "Title" String)))

intendedTargetDBS0 = Map Int (Prod String (Prod String (Prod String Int)))

intendedTargetDBS1 = (Prod (Map Int (Prod String (Prod String (Prod String Int)))) (Map (Prod Int Int) String))

-----------------------------------------------------------------------------

testFix = do
  let empF = (K String) :*: (List :@: Id)
  let emp0 = Pair (Const "Bill") (Comp [])
  let emp1 = ("Bill",[])
  putStrLn "oi"
